home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / AlphaLite.6.52 / Tcl / Modes / htmlElems.tcl < prev    next >
Encoding:
Text File  |  1997-01-21  |  30.0 KB  |  1,126 lines  |  [TEXT/ALFA]
  1. #===============================================================================
  2. # 
  3. #    htmlElems.tcl (called by html.tcl)
  4. #
  5. #    Part of HTML mode 1.4
  6. #
  7. #    Macros for HTML elements.
  8. #
  9. #    Copyright 1996, 1997 by Johan Linde <jl@theophys.kth.se>.
  10. #    This software may be used freely, and distributed freely, as long as 
  11. #    the receiver is not obligated in any way by receiving it.
  12. #
  13. #    If you make improvements to this file, please share them!
  14. #
  15. #===============================================================================
  16.  
  17.  
  18. #
  19. # <P>
  20. #
  21.  
  22. proc htmlElemParagraph {{attr ""}} {
  23.     global HTMLmodeVars
  24.     if {$HTMLmodeVars(pIsContainer)} { 
  25.         htmlBuildCR2Elem P $attr
  26.     } else {
  27.         htmlBuildOpening P 1 1 $attr
  28.     }
  29. }
  30.  
  31.  
  32. # Insert a <BR> in the end of every line in selection.
  33.  
  34. proc htmlInsertLineBreaks {} {
  35.     if {![isSelection]} {
  36.         beep
  37.         message "No selection."
  38.         return
  39.     }
  40.     
  41.     foreach ln [split [string trimright [getSelect] "\r"] "\r"] {
  42.         append text "${ln}[htmlSetCase <BR>]\r"
  43.     }
  44.     replaceText [getPos] [selEnd] $text
  45. }
  46.  
  47. # Remove all <BR> in selection.
  48. proc htmlRemoveLineBreaks {} {
  49.     if {![isSelection]} {
  50.         beep
  51.         message "No selection."
  52.         return
  53.     }
  54.     
  55.     regsub -all "<(b|B)(r|R)(\[ \t\r\]+\[^>\]*>|>)" [getSelect] "" text
  56.     if {$text != [getSelect]} {
  57.         replaceText [getPos] [selEnd] $text
  58.     }
  59. }
  60.  
  61. # Insert <P> at empty lines in selection, and in the beginning of the selection.
  62. # Several empty lines are contracted to one.
  63. proc htmlInsertParagraphs {} {
  64.     global HTMLmodeVars
  65.     if {![isSelection]} {
  66.         beep
  67.         message "No selection."
  68.         return
  69.     }
  70.     
  71.     set pIsContainer $HTMLmodeVars(pIsContainer)
  72.     
  73.     if {[set oelem [htmlOpenElem P "" 0]] == ""} {return}
  74.     
  75.     set text "\r$oelem\r"
  76.     set prevLineEmpty 1
  77.     
  78.     foreach ln [split [string trim [getSelect] "\r"] "\r"] {
  79.         regexp {[ \t]*} $ln lntest
  80.         # Only add <P> if previous line was not empty.
  81.         if {$ln == $lntest && !$prevLineEmpty} {
  82.             set prevLineEmpty 1
  83.             if {$pIsContainer} {
  84.                 append text "[htmlCloseElem P]\r\r$oelem\r"
  85.             } else {
  86.                 append text "\r$oelem\r"
  87.             }
  88.         } else {
  89.             # Skip an empty line which follows another empty line.
  90.             if {$ln != $lntest} {
  91.                 set prevLineEmpty 0
  92.                 append text "$ln\r"
  93.             }
  94.         }
  95.     }
  96.     if {$pIsContainer} {
  97.         append text "[htmlCloseElem P]\r\r"
  98.     }
  99.     
  100.     replaceText [getPos] [selEnd] $text
  101. }
  102.  
  103.  
  104. # Ask for input how to build a list. Returns "number of items" and
  105. # "ask for list item attributes". Returns "" if canceled or any problem.
  106. proc htmlListQuestions {ltype liattr lipr} {
  107.     global HTMLmodeVars
  108.     
  109.     set promptNoisily $HTMLmodeVars(promptNoisily)
  110.     if {[string length $liattr]} {
  111.         set optatts [htmlGetOptional $liattr]
  112.         set usedatts [htmlGetUsed $liattr]
  113.         set askForMore [htmlGetAttrMore $liattr]
  114.     } else {
  115.         set optatts ""
  116.         set askForMore [htmlGetAttrMore LI]
  117.         set usedatts [htmlGetUsed LI]
  118.     }
  119.     if {$lipr != "LI"} { 
  120.         set optatts [concat $optatts [htmlGetOptional DD]]
  121.         set usedatts [concat $usedatts [htmlGetUsed DD]]
  122.         if {!$askForMore} {set askForMore [htmlGetAttrMore DD]}
  123.     }
  124.     if {$HTMLmodeVars(useBigWindows)} {
  125.         set it {0 0 3 0}
  126.         while {1} {
  127.             set txt "dialog -w 280 -h 130 -b OK 20 100 75 120 -b Cancel 110 100 165 120 \
  128.             -t {$ltype list} 100 10 250 30 \
  129.             -t {How many items?} 10 40 150 60 -e [list [lindex $it 2]] 160 40 180 55"
  130.             if {[llength $optatts]} {
  131.                 append txt " -c {Ask for attributes for each $lipr} [lindex $it 3] \
  132.                 10 70 330 85"
  133.             }
  134.             set it [eval $txt]
  135.             if {[lindex $it 1]} {return}
  136.             set items [lindex $it 2]
  137.             if {[llength $it] == 4 && [lindex $it 3]} {
  138.                 set askForLiAttr 1
  139.             } else {
  140.                 set askForLiAttr 0
  141.             }
  142.             
  143.             if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
  144.                 alertnote "Invalid input: non-negative integer required"
  145.             } elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
  146.                 alertnote "Invalid input: positive integer required"
  147.             } else {
  148.                 break
  149.             }
  150.         }
  151.     } else {
  152.         if {$promptNoisily} {beep}    
  153.         while {[catch {statusPrompt "$ltype list: How many items? " htmlNumberStatusFunc} items]} {
  154.             if {$items == "Cancel all!"} {message "Cancel"; return}
  155.         }
  156.         if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
  157.             beep; message "Invalid input: non-negative integer required."; return
  158.         } elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
  159.             beep; message "Invalid input: positive integer required."; return
  160.         }
  161.         if {(([llength $optatts] && $askForMore) || [llength $usedatts]) && $items} {
  162.             if {$promptNoisily} {beep}    
  163.             while {[catch {statusPrompt "Ask for attributes for each $lipr? \[n\] " \
  164.             htmlStatusAskYesOrNo} v]} {
  165.                 if {$v == "Cancel all!"} {message "Cancel"; return}
  166.             }
  167.             if {$v == "yes"} {
  168.                 set askForLiAttr 1
  169.             } else {
  170.                 set askForLiAttr 0
  171.             }
  172.         } else {
  173.             set askForLiAttr 0
  174.         }
  175.     }
  176.     return [list $items $askForLiAttr]
  177. }
  178.     
  179.  
  180. # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
  181. # insertion point there.  If anything is selected, makes it the first item.
  182. proc htmlBuildList {ltype {liattr ""} {listattr ""}} {
  183.     global HTMLmodeVars 
  184.     global htmlCurSel
  185.     global htmlIsSel
  186.     
  187.     set useTabMarks $HTMLmodeVars(useTabMarks)
  188.     set containers $HTMLmodeVars(lidtAreContainers)
  189.     
  190.     set listStr [htmlListQuestions $ltype $liattr LI]
  191.     if {![llength $listStr]} {
  192.         return
  193.     } else {
  194.         set items [lindex $listStr 0]
  195.         set askForLiAttr [lindex $listStr 1]
  196.     }
  197.  
  198.     # If zero list items, just make an htmlBuildCR2Elem
  199.     if {$items == 0} {
  200.         htmlBuildCR2Elem $ltype $listattr
  201.         return
  202.     }
  203.     
  204.     htmlGetSel
  205.     set sel $htmlCurSel
  206.     set IsSel $htmlIsSel
  207.     set text [htmlOpenCR 1]
  208.     if {$containers} {
  209.         if {[set text1 "[htmlOpenElem $ltype $listattr 0]\r"] == "\r"} {return}
  210.         append text $text1
  211.         if {$askForLiAttr} {
  212.             set text1 [htmlOpenElem LI $liattr 0]
  213.         } else {
  214.             set text1 [htmlOpenElem LI NOATTR 0]
  215.         }
  216.         if {$text1 == ""} {return}
  217.         append text $text1
  218.         if {$IsSel} {    
  219.             append text "${sel}[htmlCloseElem LI]"
  220.             set currpos [expr [getPos] + [string length $text]]
  221.         } else {
  222.             set currpos [expr [getPos] + [string length $text]]
  223.             append text [htmlCloseElem LI]
  224.         }
  225.         for {set i 1} {$i < $items} {incr i} {
  226.             append text "\r"
  227.             if {$askForLiAttr} {
  228.                 set text1 [htmlOpenElem LI $liattr 0]
  229.             } else {
  230.                 set text1 [htmlOpenElem LI NOATTR 0]
  231.             }
  232.             if {$text1 == ""} {return}
  233.             append text $text1
  234.             if {$i == 1 && $IsSel} {
  235.                 set currpos [expr [getPos] + [string length $text]]
  236.             } elseif {$useTabMarks} {
  237.                 append text "•"
  238.             }
  239.             append text [htmlCloseElem LI]
  240.         }
  241.     } else {
  242.         if {[set text1 [htmlOpenElem $ltype $listattr 0]] == ""} {return}
  243.         append text $text1
  244.         append text "\r"
  245.         if {$askForLiAttr} {
  246.             set text1 [htmlOpenElem LI $liattr 0]
  247.         } else {
  248.             set text1 [htmlOpenElem LI NOATTR 0]
  249.         }
  250.         if {$text1 == ""} {return}
  251.         append text $text1
  252.         if {$IsSel} {        
  253.             append text $sel 
  254.         } 
  255.         set currpos [expr [getPos] + [string length $text]]
  256.         for {set i 1} {$i < $items} {incr i} {
  257.             append text "\r"
  258.             if {$askForLiAttr} {
  259.                 set text1 [htmlOpenElem LI $liattr 0]
  260.             } else {
  261.                 set text1 [htmlOpenElem LI NOATTR 0]
  262.             }
  263.             if {$text1 == ""} {return}
  264.             append text $text1
  265.             if {$useTabMarks} {append text "•"}
  266.         }
  267.     }
  268.     append text "\r[htmlCloseElem $ltype]\r\r"
  269.     if {$useTabMarks} {append text "•"}
  270.     if {$IsSel} { deleteSelection }
  271.     
  272.     insertText $text
  273.     goto $currpos
  274. }
  275.  
  276.  
  277. # Add list entry.  If there is a selection, make it the entry.
  278.  
  279. proc htmlElemListEntry {liattr} {
  280.     global htmlCurSel htmlIsSel HTMLmodeVars
  281.     
  282.     set containers $HTMLmodeVars(lidtAreContainers)
  283.     set useTabMarks $HTMLmodeVars(useTabMarks)
  284.     htmlGetSel
  285.     set sel $htmlCurSel
  286.     set isSel $htmlIsSel
  287.     set text [htmlOpenCR]
  288.     if {[set text1 [htmlOpenElem LI $liattr 0]] == ""} {return}
  289.     append text $text1
  290.     if {$isSel} { deleteSelection }
  291.     if {$containers} {
  292.         if {$isSel} { 
  293.             insertText $text "${sel}" [htmlCloseElem LI]
  294.         } else {
  295.             set currpos [expr [getPos] + [string length $text]]
  296.             append text [htmlCloseElem LI]
  297.             if {$useTabMarks} { append text "•"}
  298.             insertText $text
  299.             goto $currpos
  300.         }
  301.     } else {
  302.         insertText $text $sel
  303.     }
  304. }
  305.  
  306. # Make list items from selction.
  307. proc htmlMakeList {} {
  308.     global HTMLmodeVars
  309.     
  310.     set isContainer $HTMLmodeVars(lidtAreContainers)
  311.     
  312.     if {![isSelection]} {
  313.         beep
  314.         message "No selection."
  315.         return
  316.     }
  317.     
  318.     set values [dialog -w 220 -h 130 -t "Make list" 50 10 210 30 \
  319.     -t "Each item begins with:" 10 40 160 55 -e "*" 170 40 200 55 \
  320.     -t "List:" 10 65 50 85 -m {UL UL OL DIR MENU None} 55 65 200 85 \
  321.     -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  322.     
  323.     if {[lindex $values 3]} {return}
  324.     set itemStr [string trim [lindex $values 0]]
  325.     set listtype [lindex $values 1]
  326.     
  327.     if {![string length $itemStr]} {
  328.         beep
  329.         message "You must give a string which each item begins with."
  330.         return
  331.     }
  332.     set startPos [getPos]
  333.     set endPos [selEnd]
  334.     if {[catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res] || \
  335.     [lindex $res 1] > $endPos} {
  336.         beep 
  337.         message "No list item in selection."
  338.         return
  339.     }
  340.     # Check that the selections begins with a list item.
  341.     set preText [getText $startPos [lindex $res 0]]
  342.     if {![htmlIsWhite $preText]} {
  343.         beep
  344.         message "There is some text before the first list item."
  345.         return
  346.     }
  347.     if {$listtype != "None"} {
  348.         set text "[htmlOpenCR 1]<[htmlSetCase $listtype]>\r"
  349.     } else {
  350.         set text [htmlOpenCR]
  351.     }
  352.     # Get each list item.
  353.     set startPos [lindex $res 1]
  354.     while {![catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res2] && \
  355.     [lindex $res2 1] <= $endPos} {
  356.         set text2 [string trimleft [string trimright [getText $startPos [lindex $res2 0]] "\r"]]
  357.         append text "<[htmlSetCase LI]>$text2"
  358.         if {$isContainer} {append text [htmlCloseElem LI]}
  359.         append text "\r"
  360.         set startPos [lindex $res2 1]
  361.     }
  362.     set text2 [string trimleft [string trimright [getText $startPos $endPos] "\r"]]
  363.     append text "<[htmlSetCase LI]>$text2"
  364.     if {$isContainer} {append text [htmlCloseElem LI]}
  365.     append text "\r"
  366.     if {$listtype != "None"} {append text [htmlCloseElem $listtype] "\r\r"}
  367.     replaceText [getPos] [selEnd] $text
  368. }
  369.  
  370.  
  371. # Discursive Lists (term and description elems)
  372. #
  373. # The selection becomes the *description* (*not* the term)
  374.  
  375. # Build a discursive list
  376. proc htmlBuildDiscList {} {
  377.     global htmlCurSel
  378.     global htmlIsSel
  379.     global HTMLmodeVars 
  380.  
  381.     set containers $HTMLmodeVars(lidtAreContainers)
  382.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  383.     
  384.     set listStr [htmlListQuestions DL DT "DT and DD"]
  385.     if {![llength $listStr]} {
  386.         return
  387.     } else {
  388.         set dlEntries [lindex $listStr 0]
  389.         set askForLiAttr [lindex $listStr 1]
  390.     }
  391.     if {$askForLiAttr} {
  392.         set liattr ""
  393.     } else {
  394.         set liattr NOATTR
  395.     }
  396.     
  397.     htmlGetSel
  398.     set Sel $htmlCurSel
  399.     set text [htmlOpenCR 1]
  400.     
  401.     if {$containers} {
  402.         if {[set text1 "[htmlOpenElem DL "" 0]\r"] == "\r"} {return}
  403.         append text $text1
  404.         # the first entry
  405.         if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
  406.         append text $text1
  407.         set currpos [expr [getPos] + [string length $text]]
  408.         append text "[htmlCloseElem DT]\t"
  409.         if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
  410.         append text $text1
  411.         if {$htmlIsSel} {
  412.             append text $Sel
  413.         } elseif {$useTabMarks} {
  414.             append text "•"
  415.         }
  416.         append text [htmlCloseElem DD]
  417.         # the rest of the entries
  418.         for {set i 1} {$i < $dlEntries} {incr i} {
  419.             append text "\r"
  420.             if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
  421.             append text $text1
  422.             if {$useTabMarks} { append text "•" }
  423.             append text [htmlCloseElem DT] 
  424.             append text "\t"
  425.             if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
  426.             append text $text1
  427.             if {$useTabMarks} { append text "•" }
  428.             append text [htmlCloseElem DD] 
  429.         }
  430.         
  431.         if {$useTabMarks} {append text "•"}
  432.         
  433.     } else {
  434.         if {[set text1 [htmlOpenElem DL "" 0]] == ""} {return}
  435.         append text $text1
  436.         append text "\r"
  437.  
  438.         # The first entry
  439.         if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
  440.         append text $text1
  441.     
  442.         set currpos [expr [getPos] + [string length $text]]
  443.         append text "\t"
  444.         if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
  445.         append text $text1
  446.     
  447.         if {$htmlIsSel} {
  448.             append text $Sel
  449.         }
  450.         if {$useTabMarks} {append text "•"}        
  451.     
  452.         # Now for the rest of the entries
  453.         for {set i 1} {$i < $dlEntries} {incr i} {
  454.             append text "\r"
  455.             if {[set text1 [htmlOpenElem DT $liattr 0]] == ""} {return}
  456.             append text $text1
  457.             
  458.             if {$useTabMarks} {append text "•"}
  459.             append text "\t"
  460.             if {[set text1 [htmlOpenElem DD $liattr 0]] == ""} {return}
  461.             append text $text1
  462.         
  463.             if {$useTabMarks} {append text "•"}
  464.         }
  465.     }
  466.     append text "\r[htmlCloseElem DL]\r\r"
  467.     if {$useTabMarks} {append text "•"}
  468.     if {$htmlIsSel} { deleteSelection }
  469.     insertText $text
  470.     goto $currpos
  471. }
  472.  
  473. # Add an individual entry to a discursive list
  474. proc htmlElemDiscEntry {} {
  475.     global htmlCurSel htmlIsSel
  476.     global HTMLmodeVars
  477.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  478.     set containers $HTMLmodeVars(lidtAreContainers)
  479.     
  480.     htmlGetSel
  481.     set Sel $htmlCurSel
  482.     set text [htmlOpenCR]
  483.  
  484.     if {$containers} {
  485.         if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
  486.         append text $text1
  487.         set currpos [expr [getPos] + [string length $text]]
  488.         append text "[htmlCloseElem DT]\t"
  489.         if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
  490.         append text $text1
  491.         if {$htmlIsSel} {
  492.             append text ${Sel}
  493.         } elseif {$useTabMarks} {append text "•"}
  494.         append text [htmlCloseElem DD]
  495.         if {$useTabMarks} {append text "•"}
  496.         if {$htmlIsSel} { deleteSelection }
  497.         insertText $text [htmlCloseCR]
  498.     } else {
  499.         if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
  500.         append text $text1
  501.         set currpos [expr [getPos] + [string length $text]]
  502.         append text "\t"
  503.         if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
  504.         append text $text1
  505.     
  506.         if {$htmlIsSel} {
  507.             append text $Sel
  508.         }
  509.         if {$useTabMarks} {append text "•"}
  510.         if {$htmlIsSel} { deleteSelection }
  511.         insertText $text [htmlCloseCR]
  512.     }
  513.     goto $currpos
  514. }
  515.  
  516.  
  517. # Different Input fields
  518.  
  519. proc htmlBuildInputElem {inputelem {cr1 0} {cr2 1}} {
  520.     htmlBuildOpening "INPUT TYPE=\"${inputelem}\"" $cr1 $cr2 $inputelem
  521. }
  522.  
  523.  
  524. # Table template. If there is any selection it is put in the first cell.
  525. proc htmlTableTemplate {} {
  526.     global htmlCurSel htmlIsSel HTMLmodeVars
  527.     
  528.     set useTabMarks $HTMLmodeVars(useTabMarks)
  529.     
  530.     set values {"" "" 0 0 0}
  531.     set rows ""
  532.     set cols ""
  533.     set tableOpen "<[htmlSetCase TABLE]>"
  534.     set trOpen "<[htmlSetCase TR]>"
  535.     while {1} {
  536.         
  537.         set box "-t {Table template} 50 10 200 25 \
  538.         -p 50 26 150 27 \
  539.         -t {Number of rows} 10 40 150 55  -e [list [lindex $values 0]] 160 40 180 55 \
  540.         -t {Number of columns} 10 65 150 80 -e [list [lindex $values 1]] 160 65 180 80 \
  541.         -c {Table headers in first row} [lindex $values 2] 10 90 250 112 \
  542.         -c {Table headers in first column} [lindex $values 3] 10 112 250 134 \
  543.         -c {Don't insert TABLE tags} [lindex $values 4] 10 134 250 156 \
  544.         -b OK 20 250 85 270 -b Cancel 105 250 170 270\
  545.         -b {TABLE attributes} 10 170 150 190 -b {TR attributes} 10 200 150 220 "
  546.         
  547.         set values [eval [concat dialog -w 230 -h 280 $box]]
  548.         
  549.         # Cancel?
  550.         if {[lindex $values 6] } {return}
  551.         
  552.         set rows [lindex $values 0]
  553.         set cols [lindex $values 1]
  554.         set THrow [lindex $values 2]
  555.         set THcol [lindex $values 3]
  556.         set table [expr ![lindex $values 4]]
  557.         if {[lindex $values 7]} {
  558.             if {!$table} {
  559.                 alertnote "You have chosen not to insert TABLE tags."
  560.             } elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
  561.                 set tableOpen $tmp
  562.             }
  563.             continue
  564.         }
  565.         if {[lindex $values 8]} {
  566.             if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
  567.                 set trOpen $tmp
  568.             }
  569.             continue
  570.         }
  571.         
  572.         
  573.         if {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols] } {
  574.             alertnote "The number of rows and columns must be specified."
  575.         } else {
  576.             break
  577.         }
  578.     }
  579.     
  580.     htmlGetSel
  581.     if {$htmlIsSel} {deleteSelection}
  582.     
  583.     set text [htmlOpenCR 1]
  584.     if {$table} {append text "\r" $tableOpen "\r"}
  585.     
  586.     for {set i 1} {$i <= $rows} {incr i} {
  587.         if {$i > 1 || $table} {append text "\r"}
  588.         append text "$trOpen\r"
  589.         for {set j 1} {$j <= $cols} {incr j} {
  590.             # Put TH in first row or column?
  591.             if {$i == 1 && $THrow || $j == 1 && $THcol} {
  592.                 set cell [htmlSetCase TH]
  593.             } else {
  594.                 set cell [htmlSetCase TD]
  595.             }
  596.             append text "<$cell>"
  597.             if {$i == 1 && $j == 1} {
  598.                 if {$htmlIsSel} {
  599.                     append text $htmlCurSel
  600.                 } else {
  601.                     set curPos [expr [getPos] + [string length $text]]
  602.                 }
  603.             } elseif {$htmlIsSel && ( $i == 1 && $j == 2 || $i == 2 && $cols == 1 )} {
  604.                 set curPos [expr [getPos] + [string length $text]]
  605.             } elseif {$useTabMarks} {
  606.                 append text "•"
  607.             }    
  608.             append text [htmlCloseElem $cell]
  609.         }
  610.         append text "\r[htmlCloseElem TR]\r"
  611.     }
  612.     if {$table} {append text "\r[htmlCloseElem TABLE]\r\r"}
  613.     if {$useTabMarks && ($rows > 1 || $cols > 1 || !$htmlIsSel)} {append text "•"}
  614.     insertText $text
  615.     goto $curPos
  616. }
  617.  
  618.  
  619. # Take table rows in a selection and remove the TR, TD and TH elements and
  620. # put tabs between the elements.
  621. proc htmlrowsToTabs {} {
  622.     if {![isSelection]} {
  623.         beep
  624.         message "No selection."
  625.         return
  626.     }
  627.     
  628.     set startPos [getPos]
  629.     set endPos [selEnd]
  630.     if {[catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res] || \
  631.     [lindex $res 1] > $endPos} {
  632.         beep 
  633.         message "No table row in selection."
  634.         return
  635.     }
  636.     # Check that the selections begins with a table row.
  637.     set preText [getText $startPos [lindex $res 0]]
  638.     if {![htmlIsWhite $preText]} {
  639.         beep
  640.         message "First part of selection is not in a table row."
  641.         return
  642.     }
  643.     # Extract each table row.
  644.     set startPos [lindex $res 1]
  645.     while {![catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res2] && \
  646.     [lindex $res2 1] <= $endPos} {
  647.         set text2 [getText $startPos [lindex $res2 0]]
  648.         regsub -all "\[\t\r\]+" $text2 " " text2
  649.         append text [string trim $text2] "\r"
  650.         set startPos [lindex $res2 1]
  651.     }
  652.     set text2 [getText $startPos $endPos]
  653.     regsub -all "\[\t\r\]+" $text2 " " text2
  654.     append text [string trim $text2]
  655.     
  656.     # Check that there is nothing after the last table row.
  657.     if {![catch {search -s -f 1 -i 1 -r 1 -m 0 {</TR>} $startPos} res] \
  658.     && [lindex $res 1] <= $endPos} {
  659.         set preText [getText [lindex $res 1] $endPos]
  660.         if {![htmlIsWhite $preText]} {
  661.             beep
  662.             message "Last part of selection not in a table row."
  663.             return
  664.         }
  665.     }
  666.     # Make the transformation.
  667.     foreach ln [split $text "\r"] {
  668.         if {![string length $ln]} continue
  669.         regsub -all {> +<} $ln "><" ln
  670.         regsub -all {<(t|T)(h|H|d|D)([ ]+[^>]*>|>)} $ln "\t" ln
  671.         regsub {    } $ln "" ln
  672.         regsub -all {</(t|T)(h|H|d|D|r|R)>} $ln "" ln
  673.         append out "$ln\r"
  674.     }
  675.     replaceText [getPos] [selEnd] $out
  676. }
  677.  
  678. # Convert tab-delimited format to table rows.
  679. # First row and first coloumn can optionally consist of table headers.
  680. proc htmltabsToRows {where} {
  681.     global HTMLmodeVars
  682.     
  683.     if {$where == "selection"} {
  684.         if {![isSelection]} {
  685.             beep
  686.             message "No selection."
  687.             return
  688.         }
  689.         set tabtext [string trim [getSelect]]
  690.         set newln "\r"
  691.         set htext "Tabs to Rows"
  692.     } else {
  693.         set fil [getfile "Select file with table."]
  694.         if {![htmlIsTextFile $fil alertnote]} {return}
  695.         set fid [open $fil r]
  696.         set tabtext [string trim [read $fid]]
  697.         close $fid
  698.         if {[regexp {\n} $tabtext]} {
  699.             set newln "\n"
  700.         } else {
  701.             set newln "\r"
  702.         }
  703.         regsub -all "\n\r" $tabtext "\n" tabtext
  704.         set htext "Import table"
  705.     }
  706.     set values {0 0 0}
  707.     set tableOpen "<[htmlSetCase TABLE]>"
  708.     set trOpen "<[htmlSetCase TR]>"
  709.     while {1} {
  710.         
  711.         set box "-t [list $htext] 50 10 200 25 \
  712.         -p 50 26 150 27 \
  713.         -c {Table headers in first row} [lindex $values 0] 10 40 250 62 \
  714.         -c {Table headers in first column} [lindex $values 1] 10 62 250 84 \
  715.         -c {Don't insert TABLE tags} [lindex $values 2] 10 84 250 106 \
  716.         -b OK 20 200 85 220 -b Cancel 105 200 170 220\
  717.         -b {TABLE attributes} 10 120 150 140 -b {TR attributes} 10 150 150 170 "
  718.         
  719.         set values [eval [concat dialog -w 230 -h 230 $box]]
  720.         
  721.         # Cancel?
  722.         if {[lindex $values 4] } {return}
  723.         
  724.         set THrow [lindex $values 0]
  725.         set THcol [lindex $values 1]
  726.         set table [expr ![lindex $values 2]]
  727.         if {[lindex $values 5]} {
  728.             if {!$table} {
  729.                 alertnote "You have chosen not to insert TABLE tags."
  730.             } elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
  731.                 set tableOpen $tmp
  732.             }
  733.             continue
  734.         }
  735.         if {[lindex $values 6]} {
  736.             if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
  737.                 set trOpen $tmp
  738.             }
  739.             continue
  740.         }
  741.         break
  742.     }
  743.             
  744.     set oelem "${trOpen}\r"
  745.     if {$oelem == "\r"} {return}
  746.     
  747.     
  748.     set out [htmlOpenCR 1]
  749.     if {$table} {append out "\r" $tableOpen "\r"}
  750.  
  751.     set i 1
  752.     foreach ln [split $tabtext $newln] {
  753.         if {![string length $ln]} {
  754.             append out "$oelem[htmlCloseElem TR]\r"
  755.         } else {
  756.             # Should there be headers in the first row?
  757.             if {$i == 1 && $THrow} {
  758.                 set cell TH
  759.             } else {
  760.                 set cell TD
  761.             }
  762.             # Should there be headers in the first column?
  763.             if {$THcol || ($i == 1 && $THrow)} {
  764.                 set fcell TH
  765.             } else {
  766.                 set fcell TD
  767.             }
  768.             regsub -all {    } $ln [htmlSetCase "</$cell><$cell>"] ln
  769.             if {$THcol} {
  770.                 regsub {[tT][dDhH]} $ln [htmlSetCase TH] ln
  771.             }
  772.             if {$i > 1 || $table} {append out "\r"}
  773.             append out "$oelem<[htmlSetCase $fcell]>$ln"
  774.             # Add cell or fcell closing, depending on if there is more than one cell.
  775.             if {![regexp [htmlCloseElem $fcell] $ln]} {
  776.                 append out [htmlCloseElem $fcell]
  777.             } else {
  778.                 append out [htmlCloseElem $cell]
  779.             }
  780.             append out "\r[htmlCloseElem TR]\r"
  781.         }
  782.         incr i
  783.     }
  784.     if {$table} {append out "\r[htmlCloseElem TABLE]\r\r"}
  785.     if {$where == "selection"} {
  786.         replaceText [getPos] [selEnd] $out
  787.     } else {
  788.         insertText $out
  789.     }
  790. }
  791.  
  792.  
  793. # Converts an NCSA or CERN image map file to a client side image map.
  794. proc htmlConvertMap {type} {
  795.     if {[catch {getfile "Select the $type image map file."} fil] || ![htmlIsTextFile $fil alertnote] ||
  796.     [catch {open $fil r} fid]} {return}
  797.     set filecont [read $fid]
  798.     close $fid
  799.     if {[regexp {\n} $filecont]} {
  800.         set newln "\n"
  801.     } else {
  802.         set newln "\r"
  803.     }
  804.     set area [html${type}map [split $filecont $newln]]
  805.     set text [lindex $area 2]
  806.     if {![string length $text]} {
  807.         alertnote "No image map found in [file tail $fil]."
  808.         return
  809.     } elseif {[lindex $area 1]} {
  810.         if {[askyesno "Some lines in [file tail $fil] have invalid syntax. They are ignored. Continue?"] == "no"} {return}
  811.     } elseif {[lindex $area 0]} {
  812.         if {[askyesno "Some lines in [file tail $fil] specify a shape not supported. They are ignored. Continue?"] == "no"} {return}
  813.     }
  814.     if {![string length [set map [htmlOpenElem MAP "" 0]]]} {return}
  815.     insertText [htmlOpenCR 1] $map "\r" $text [htmlCloseElem MAP] "\r\r"
  816. }
  817.  
  818. proc htmlNCSAmap {lines} {
  819.     set notknown 0
  820.     set someinvalid 0
  821.     set area ""
  822.     set defarea ""
  823.     foreach l $lines {
  824.         set invalid 0
  825.         set l [string trim $l]
  826.         # Skip comments and blank lines
  827.         if {[regexp {^#} $l] || ![string length $l]} {continue}
  828.         set shape [string toupper [lindex $l 0]]
  829.         if {[lsearch {RECT CIRCLE POLY DEFAULT} $shape] < 0} {
  830.             set notknown 1
  831.             continue
  832.         }
  833.         set url [lindex $l 1]
  834.         set exp "^\[0-9\]+,\[0-9\]+$"
  835.         if {[regexp $exp $url]} {
  836.             set url ""
  837.             set cind 1
  838.         } else {
  839.             set cind 2
  840.         }
  841.         switch $shape {
  842.             RECT {
  843.                 if {[regexp $exp [lindex $l $cind]] && [regexp $exp [lindex $l [expr $cind + 1]]]} {
  844.                     set coord "[lindex $l $cind],[lindex $l [expr $cind + 1]]"
  845.                 } else {
  846.                     set invalid 1
  847.                 }
  848.             }
  849.             CIRCLE {
  850.                 if {[regexp $exp [lindex $l $cind] cent] && [regexp $exp [lindex $l [expr $cind + 1]] edge]} {
  851.                     regexp {[0-9]+} $cent xc
  852.                     regexp {[0-9]+} $edge xe
  853.                     set coord "$cent,[expr $xe-$xc]"
  854.                 } else {
  855.                     set invalid 1
  856.                 }
  857.             }
  858.             POLY {
  859.                 set coord ""
  860.                 foreach c [lrange $l $cind end] {
  861.                     if {![regexp $exp $c]} {
  862.                         set invalid 1
  863.                         break
  864.                     }
  865.                     append coord "$c,"
  866.                 }
  867.                 set coord [string trimright $coord ,]
  868.             }
  869.         }
  870.         if {!$invalid} {
  871.             if {$shape == "DEFAULT"} {
  872.                 set toapp defarea
  873.             } else {
  874.                 set toapp area
  875.             }
  876.             append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
  877.             if {$shape != "DEFAULT"} {
  878.                 append $toapp " [htmlSetCase COORDS]=\"$coord\""
  879.             }
  880.             if {[string length $url]} {
  881.                 append $toapp " [htmlSetCase HREF]=\"$url\""
  882.             } else {
  883.                 append $toapp " [htmlSetCase NOHREF]"
  884.             }
  885.             append $toapp ">\r"
  886.         } else {
  887.             set someinvalid 1
  888.         }
  889.     }
  890.     append area $defarea
  891.     return [list $notknown $someinvalid $area] 
  892. }
  893.  
  894. proc htmlCERNmap {lines} {
  895.     set notknown 0
  896.     set someinvalid 0
  897.     set area ""
  898.     set defarea ""
  899.     foreach l $lines {
  900.         set invalid 0
  901.         set l [string trim $l]
  902.         # Skip comments and blank lines
  903.         if {[regexp {^#} $l] || ![string length $l]} {continue}
  904.         set shape [string toupper [lindex $l 0]]
  905.         if {![string match RECT* $shape] && ![string match CIRC* $shape] &&
  906.         ![string match POLY* $shape] && ![string match DEFAULT $shape]} {
  907.             set notknown 1
  908.             continue
  909.         }
  910.         set exp "^\\(\[0-9\]+,\[0-9\]+\\)$"
  911.         switch -glob $shape {
  912.             RECT* {
  913.                 set url [lindex $l 3]
  914.                 if {[regexp $exp [lindex $l 1]] && [regexp $exp [lindex $l 2]]} {
  915.                     set coord "[string trimleft [string trimright [lindex $l 1] )] (],[string trimleft [string trimright [lindex $l 2] )] (]"
  916.                     set shape RECT
  917.                 } else {
  918.                     set invalid 1
  919.                 }
  920.             }
  921.             CIRC* {
  922.                 set url [lindex $l 3]
  923.                 if {[regexp $exp [lindex $l 1]] && [regexp {^[0-9]+$} [lindex $l 2]]} {
  924.                     set coord "[string trimleft [string trimright [lindex $l 1] )] (],[lindex $l 2]"
  925.                     set shape CIRCLE
  926.                 } else {
  927.                     set invalid 1
  928.                 }
  929.             }
  930.             POLY* {
  931.                 set coord ""
  932.                 set url [lindex $l [expr [llength $l] - 1]]
  933.                 if {[regexp $exp $url]} {
  934.                     set url ""
  935.                     set cind 1
  936.                 } else {
  937.                     set cind 2
  938.                 }
  939.                 foreach c [lrange $l 1 [expr [llength $l] - $cind]] {
  940.                     if {![regexp $exp $c]} {
  941.                         set invalid 1
  942.                         break
  943.                     }
  944.                     append coord "[string trimleft [string trimright $c )] (],"
  945.                 }
  946.                 set coord [string trimright $coord ,]
  947.                 set shape POLY
  948.             }
  949.             DEFAULT {
  950.                 set url [lindex $l 1]
  951.             }
  952.         }
  953.         if {!$invalid} {
  954.             if {$shape == "DEFAULT"} {
  955.                 set toapp defarea
  956.             } else {
  957.                 set toapp area
  958.             }
  959.             append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
  960.             if {$shape != "DEFAULT"} {
  961.                 append $toapp " [htmlSetCase COORDS]=\"$coord\""
  962.             }
  963.             if {[string length $url]} {
  964.                 append $toapp " [htmlSetCase HREF]=\"$url\""
  965.             } else {
  966.                 append $toapp " [htmlSetCase NOHREF]"
  967.             }
  968.             append $toapp ">\r"
  969.         } else {
  970.             set someinvalid 1
  971.         }
  972.     }
  973.     append area $defarea
  974.     return [list $notknown $someinvalid $area] 
  975. }
  976.  
  977. proc htmlElemComment {} {
  978.     global htmlCurSel
  979.     global htmlIsSel
  980.     global HTMLmodeVars
  981.     set comStrs [htmlCommentStrings]
  982.     htmlGetSel
  983.     if {$htmlIsSel} { deleteSelection }
  984.     set text "[htmlOpenCR][lindex $comStrs 0]$htmlCurSel"
  985.     set currpos [expr [getPos] + [string length $text]]
  986.     append text [lindex $comStrs 1] [htmlCloseCR]
  987.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  988.     insertText $text
  989.     if {!$htmlIsSel}    {
  990.         goto $currpos
  991.     }
  992. }
  993.  
  994.  
  995. #
  996. # Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
  997. # Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
  998. # We do not put in a DOCTYPE line.
  999. proc htmlNewTemplate {doctype} {
  1000.     global htmlCurSel htmlIsSel HTMLmodeVars htmlHeadElements1 htmlHeadElements3 htmlPackageToUse
  1001.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  1002.     set footers $HTMLmodeVars(footers)
  1003.     set headelems [set htmlHeadElements$htmlPackageToUse]
  1004.     
  1005.     set bodyText ""
  1006.     # If the window is not empty, either delete text or put it in the body.
  1007.     if {![htmlIsEmptyFile]} {
  1008.         set delBox [dialog -w 320 -h 90 -t "Nonempty window. Do you want to put the text\
  1009.         in the document's BODY, or delete it?" 10 10 310 50 \
  1010.         -b "Put in BODY" 20 60 120 80 -b Delete 140 60 205 80 -b Cancel 225 60 290 80]
  1011.         if {[lindex $delBox 1]} {
  1012.             deleteText 0 [maxPos]
  1013.         } elseif {[lindex $delBox 2]} {
  1014.             return
  1015.         } else {
  1016.             set bodyText "[getText 0 [maxPos]]\r"
  1017.         }
  1018.     } 
  1019.     
  1020.     if {$doctype == "FRAMESET"} {
  1021.         set htxt "New document with frames"
  1022.     } else {
  1023.         set htxt "New document"
  1024.     }
  1025.     # Building footer menu.
  1026.     foreach f $footers {
  1027.         lappend foot [file tail $f]
  1028.     }
  1029.     set footmenu {"No footer"}
  1030.     if {[info exists foot]} {
  1031.         set footmenu [concat $footmenu [lsort $foot]]
  1032.     }
  1033.     
  1034.     set docTitle ""
  1035.     set inHead {0 0 ""}
  1036.     foreach elem $headelems {
  1037.         lappend inHead 0
  1038.     }
  1039.     lappend inHead "No footer"
  1040.     while {![string length $docTitle]} {
  1041.         
  1042.         # Construct the dialog box.
  1043.         set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 \
  1044.         -e [list [lindex $inHead 2]] 70 40 390 55 \
  1045.         -t {Select the elements you want in the document\'s HEAD} 10 70 390 85"
  1046.         set hpos 100
  1047.         set wpos 10
  1048.         set i 3
  1049.         foreach elem $headelems {
  1050.             append box " -c $elem [lindex $inHead $i] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]"
  1051.             incr wpos 100
  1052.             if {$wpos > 110} {set wpos 10; incr hpos 20}
  1053.             incr i
  1054.         }
  1055.         if {$wpos > 10} {incr hpos 20}
  1056.         incr hpos 10
  1057.         append box " -t Footer 10 $hpos 80 [expr $hpos + 15] \
  1058.         -m [list [concat [list [lindex $inHead $i]] $footmenu]] 90 $hpos 250 [expr $hpos + 15]"
  1059.         incr hpos 30 
  1060.         set inHead [eval [concat dialog -w 400 -h [expr $hpos + 30] \
  1061.         -b OK 20 $hpos 85 [expr $hpos + 20] \
  1062.         -b Cancel 110 $hpos 175 [expr $hpos + 20] $box]]
  1063.         if {[lindex $inHead 1] } {
  1064.             if {[lindex $delBox 1]} {undo}
  1065.             return
  1066.         }
  1067.         set docTitle [string trim [lindex $inHead 2]]
  1068.         if {![string length $docTitle]} {
  1069.             alertnote "A document title is required."
  1070.         }
  1071.     }
  1072.     
  1073.     
  1074.     if {[set text [htmlOpenElem HTML "" 0]] == "" || 
  1075.     [set text1 [htmlOpenElem HEAD "" 0]] == "" ||
  1076.     [set text2 [htmlOpenElem TITLE "" 0]] == ""} {
  1077.         if {[lindex $delBox 1]} {undo}
  1078.         return
  1079.     }
  1080.     append text "\r\r${text1}\r\r"
  1081.     append text "${text2}${docTitle}[htmlCloseElem TITLE]\r"
  1082.     set hasScript 0
  1083.     for {set i 0} {$i < [llength  $headelems]} {incr i} {
  1084.         if {[lindex $inHead [expr $i + 3]]} {
  1085.             if {[set text1 [htmlOpenElem [lindex $headelems $i] "" 0]] != ""} {
  1086.                 append text "\r${text1}"
  1087.                 if {[lindex $headelems $i] == "SCRIPT"} {
  1088.                     append text "\r<!-- Hide content from old browsers\r"
  1089.                     set currpos [string length $text]
  1090.                     set hasScript 1
  1091.                     append text "\r// end hiding content from old browsers -->\r[htmlCloseElem SCRIPT]"
  1092.                 }
  1093.             }
  1094.         }
  1095.     }
  1096.     append text "\r\r[htmlCloseElem HEAD]\r\r"
  1097.     
  1098.     if {[set text1 [htmlOpenElem $doctype "" 0]] == ""} {
  1099.         if {[lindex $delBox 1]} {undo}
  1100.         return
  1101.     }
  1102.     append text "$text1\r\r"
  1103.     append text $bodyText
  1104.     if {!$hasScript} {
  1105.         set currpos [string length $text]
  1106.     } elseif {$useTabMarks} {
  1107.         append text "•"
  1108.     }    
  1109.     
  1110.     # Insert footer.
  1111.     set footval [lindex $inHead [expr [llength $headelems] + 3]]
  1112.     if {$footval != "No footer"} {
  1113.         set footerFile [lindex $footers [lsearch -exact $foot $footval]]
  1114.         if {![catch {readFile $footerFile} footText]} {
  1115.             append text "\r\r$footText"
  1116.         } else {
  1117.             alertnote "Could not read footer, $footerFile"
  1118.         }
  1119.     }
  1120.     append text "\r\r[htmlCloseElem $doctype]\r\r[htmlCloseElem HTML]"
  1121.     if {![htmlIsEmptyFile]} {deleteText 0 [maxPos]}
  1122.     insertText $text
  1123.  
  1124.     goto $currpos
  1125. }
  1126.